(DEFPROP CYCDRAFNS
(CYCDRAFNS (SPECIAL XBOT XSCL YBOT YSCL REALWIDTH REALHEIGHT
CTAB PATS CURPAT PATSELECT TITLE LINE
LABELL NLN NMX LLN FIXE FACENUM
REALBOTTOM REALEFT EPSILON)
PATS PATSELECT (ARRAY TMP T 20.0)
(ARRAY CONN T 20.0)
(ARRAY NODE T 40.0)
PUSH ! POP STORENODEY STORENODE NODEY DRAWS
PRINRAD PRINENTRY NUMNODES LAYOUT ANALIN PRINRAD1
PRINCTAB PRINRADOFF)
VALUE)
(SPECIAL XBOT XSCL YBOT YSCL REALWIDTH REALHEIGHT CTAB PATS CURPAT
PATSELECT TITLE LINE LABELL NLN NMX LLN FIXE FACENUM
REALBOTTOM REALEFT EPSILON)
(DEFPROP PATS
(PATS (TRAP ((1.0 4.0 3.0 2.0)
(2.0 4.0 3.0 1.0)
(3.0 4.0 2.0 1.0)
(4.0 3.0 2.0 1.0))
(5.0 (4.0 3.0 3.0 3.0 3.0)
((1.0 4.0 (1.0 2.0 3.0 4.0))
(2.0 3.0 (1.0 3.0 4.0))
(3.0 3.0 (1.0 2.0 4.0))
(4.0 3.0 (1.0 2.0 3.0))
(5.0 3.0 (2.0 3.0 4.0))))
((4.0 5.0 3.0 2.0 1.0)
(3.0 5.0 4.0 2.0 1.0)
(2.0 5.0 4.0 3.0 1.0)
(1.0 4.0 3.0 2.0 1.0))
(((3.0 . 4.0)
1.0)
((2.0 . 4.0)
1.0)
((2.0 . 3.0)
1.0)
((1.0 . 4.0)
1.0)
((1.0 . 3.0)
1.0)
((1.0 . 2.0)
1.0))
((1.0 0.0 0.0)
(2.0 1.0 2.0)
(3.0 2.0 0.0)
(4.0 1.0 1.0)))
(HEX ((1.0 2.0 6.0)
(2.0 3.0 1.0)
(3.0 4.0 2.0)
(4.0 5.0 3.0)
(5.0 6.0 4.0)
(6.0 5.0 1.0))
(1.0 (6.0)
((1.0 6.0 (1.0 6.0 5.0 4.0 3.0 2.0))))
((6.0 1.0)
(5.0 1.0)
(4.0 1.0)
(3.0 1.0)
(2.0 1.0)
(1.0 1.0))
(((5.0 . 6.0)
1.0)
((4.0 . 5.0)
1.0)
((3.0 . 4.0)
1.0)
((2.0 . 3.0)
1.0)
((1.0 . 2.0)
1.0)
((1.0 . 6.0)
1.0))
((1.0 1.0 3.0)
(2.0 2.0 2.0)
(3.0 2.0 1.0)
(4.0 1.0 0.0)
(5.0 0.0 1.0)
(6.0 0.0 2.0)))
(PENT ((1.0 5.0 2.0)
(2.0 3.0 1.0)
(3.0 4.0 2.0)
(4.0 5.0 3.0)
(5.0 1.0 4.0))
(1.0 (5.0)
((1.0 5.0 (1.0 2.0 3.0 4.0 5.0))))
((5.0 1.0)
(4.0 1.0)
(3.0 1.0)
(2.0 1.0)
(1.0 1.0))
(((4.0 . 5.0)
1.0)
((3.0 . 4.0)
1.0)
((2.0 . 3.0)
1.0)
((1.0 . 5.0)
1.0)
((1.0 . 2.0)
1.0))
((1.0 0.0 1.0)
(2.0 1.0 2.0)
(3.0 2.0 1.0)
(4.0 2.0 0.0)
(5.0 0.0 0.0)))
(OCT ((1.0 2.0 8.0)
(2.0 3.0 1.0)
(3.0 4.0 2.0)
(4.0 5.0 3.0)
(5.0 6.0 4.0)
(6.0 7.0 5.0)
(7.0 8.0 6.0)
(8.0 1.0 7.0))
(1.0 (8.0)
((1.0 8.0
(1.0 8.0 7.0 6.0 5.0 4.0 3.0 2.0))))
((8.0 1.0)
(7.0 1.0)
(6.0 1.0)
(5.0 1.0)
(4.0 1.0)
(3.0 1.0)
(2.0 1.0)
(1.0 1.0))
(((7.0 . 8.0)
1.0)
((6.0 . 7.0)
1.0)
((5.0 . 6.0)
1.0)
((4.0 . 5.0)
1.0)
((3.0 . 4.0)
1.0)
((2.0 . 3.0)
1.0)
((1.0 . 2.0)
1.0)
((1.0 . 8.0)
1.0))
((1.0 0.0 2.0)
(2.0 1.0 3.0)
(3.0 2.0 3.0)
(4.0 3.0 2.0)
(5.0 3.0 1.0)
(6.0 2.0 0.0)
(7.0 1.0 0.0)
(8.0 0.0 1.0))))
VALUE)
(DEFPROP PATSELECT (PATSELECT (4.0 15.0 15.0)
(3.0 16.0 17.0)
(1.0 17.0 15.0)
(2.0 16.0 16.0))
VALUE)
(ARRAY TMP T 20.0)
(ARRAY CONN T 20.0)
(ARRAY NODE T 40.0)
(DEFPROP PUSH (LAMBDA (X)
(LIST (QUOTE SETQ)
(QUOTE STACK)
(APPEND (QUOTE (! CONS))
(CDR X)
(QUOTE (STACK)))))
MACRO)
(DEFPROP ! (LAMBDA
(L)
((LABEL FOO (LAMBDA
(LL)
(COND ((NULL (CDR LL))
NIL)
((NULL (CDDR LL))
(CADR LL))
((NULL (CDDDR LL))
LL)
(T (LIST (CAR LL)
(CADR LL)
(FOO (CONS (CAR LL)
(CDDR LL))))))))
(CDR L)))
MACRO)
(DEFPROP POP (LAMBDA (X)
(LIST (QUOTE PROG1)
(LIST (QUOTE SETQ)
(CADR X)
(QUOTE (CAR STACK)))
(QUOTE (SETQ STACK (CDR STACK)))))
MACRO)
(DEFPROP STORENODEY (LAMBDA (EXPR)
(LIST (QUOTE STORE)
(LIST (QUOTE NODE)
(LIST (QUOTE PLUS)
20.0
(CADR EXPR)))
(CADDR EXPR)))
MACRO)
(DEFPROP STORENODE (LAMBDA (L)
(LIST (QUOTE STORE)
(LIST (QUOTE NODE)
(CADR L))
(CADDR L)))
MACRO)
(DEFPROP NODEY (LAMBDA (L)
(LIST (QUOTE NODE)
(LIST (QUOTE PLUS)
20.0
(CADR L))))
MACRO)
(DEFPROP
DRAWS
(LAMBDA
(STRUC ID)
(PROG
(CTAB)
(SETQ CTAB (CTABLE STRUC))
(LAYOUT
(CONS (COND (ID ID)
(T (UGRAPH STRUC)))
(FOR NEW CTE IN CTAB LIST
(CONS (NODENUM CTE)
(CONS (ATOMTYPE (MARKERS CTE))
(FOR NEW X IN (NBRS CTE)
WHEN
(NUMBERP X)
LIST X))))))))
EXPR)
(DEFPROP PRINRAD (LAMBDA (L)
(PROG (CTAB)
(PRINRAD1 NIL
(FOR NEW I := ((NUMNODES
L)
1.0 -1.0)
XLIST I)
L)
(LAYOUT (CONS TITLE CTAB))))
EXPR)
(DEFPROP PRINENTRY (LAMBDA (N AT CON)
(SETQ CTAB (CONS (CONS N (CONS AT CON))
CTAB)))
EXPR)
(DEFPROP
NUMNODES
(LAMBDA
(RAD)
(FOR NEW R IN (ATTACHEDRADS RAD)
PLUS FIRST (IF (NULL (CENTER RAD))
THEN 0.0 ELSEIF (ATOM (CENTER RAD))
THEN 1.0 ELSEIF
(NOT (STRUCTURE? (RADSTRUC (CENTER RAD))))
THEN 1.0 ELSE
(LENGTH (NODES (RADSTRUC (CENTER RAD)))))
(TIMES (CDR R)
(NUMNODES (CAR R)))))
EXPR)
(DEFPROP LAYOUT (LAMBDA (X)
(PROG NIL (ANALIN X)
(PATMATCH)
(SORTLN)
(FINDNDS 1.0 NIL)
(RETURN (OUTNDS))))
EXPR)
(DEFPROP
ANALIN
(LAMBDA
(X)
(PROG (X1 X2 X3 X4)
(FOR NEW I := (1.0 19.0)
DO
(STORE (CONN I)
NIL))
(SETQ TITLE (CAR X))
(SETQ LINE NIL)
(SETQ LABELL NIL)
(SETQ NLN (LENGTH (CDR X)))
(SETQ NMX 0.0)
(FOR X1 IN (CDR X)
AS NMX IS (MAX (CAR X1)
NMX)
AS X2 IS (CAR X1)
AS LABELL IS (CONS (CONS X2 (CADR X1))
LABELL)
FOR X3 IN (CDDR X1)
DO
(SETQ X4 (ASSOC2 (CONS X2 X3)
LINE))
(COND ((NULL X4)
(COND ((ASSOC2 (CONS X3 X2)
LINE)
NIL)
(T (SETQ LINE (CONS (LIST (CONS X2 X3)
1.0)
LINE)))))
(T (RPLACA (CDR X4)
(ADD1 (CADR X4)))))
(COND ((MEMBER X3 (CONN X2))
NIL)
(T (STORE (CONN X2)
(CONS X3 (CONN X2))))))
(SETQ LLN (LENGTH LINE))
(RETURN LINE)))
EXPR)
(DEFPROP
PRINRAD1
(LAMBDA
(EFF AA RAD)
(PROG
(CENT ATTACHED J X TTABLE)
(SETQ CENT (CENTER RAD))
(SETQ ATTACHED (CLEXPAND (ATTACHEDRADS RAD)))
(RETURN
(IF (NOT CENT)
THEN
(PRINRAD1 (CADR AA)
(CONS (CAR AA)
(PRINRAD1 (CAR AA)
(CDR AA)
(CAR ATTACHED)))
(CADR ATTACHED))
ELSEIF
(OR (ATOM CENT)
(NOT (EQ (ID (RADSTRUC CENT))
(QUOTE STRUC))))
THEN
(SETQ X (CDR AA))
(FOR NEW R IN ATTACHED DO (SETQ J (CONS (CAR X)
J))
(SETQ X (PRINRAD1 (CAR AA)
X R)))
(PRINENTRY (CAR AA)
CENT
(IF EFF THEN (CONS EFF J)
ELSE J))
X ELSE (SETQ X (IF (NOT EFF)
THEN AA ELSE
(SETQ TTABLE
(LIST (LIST (AFFLINK CENT)
(CAR AA)
EFF)))
(CDR AA)))
(FOR NEW N IN (NODES (RADSTRUC CENT))
WHEN
(NOT (EQUAL N (AFFLINK CENT)))
DO
(SETQ TTABLE (CONS (LIST N (CAR X))
TTABLE))
(SETQ X (CDR X)))
(FOR NEW NLIST IN (CUFFLINKS CENT)
FOR NEW C IN NLIST AS NEW CT IS
(LMASSOC C TTABLE NIL)
DO
(NCONC CT (LIST (CAR X)))
(SETQ X (PRINRAD1 (CAR CT)
X
(CAR ATTACHED)))
(SETQ ATTACHED (CDR ATTACHED)))
(PRINCTAB (CTABLE (RADSTRUC CENT))
TTABLE)
X))))
EXPR)
(DEFPROP
PRINCTAB
(LAMBDA
(CTAB TTABLE)
(FOR NEW CT IN CTAB AS NEW CPRIME IS (LMASSOC (NODENUM CT)
TTABLE NIL)
DO
(PRINENTRY (CAR CPRIME)
(ATOMTYPE MARKERS CT)
(APPEND (CDR CPRIME)
(FOR NEW Y IN (NBRS CT)
IF
(NOT (EQ Y (QUOTE FV)))
XLIST
(CAR (LMASSOC Y TTABLE NIL)))))))
EXPR)
(DEFPROP PRINRADOFF (LAMBDA (L)
(PROG NIL (QUOTE (TTAB 1.0))
(PRIN1 (QUOTE STRUCTURE=))
(PRINT L)
(FOR NEW X IN XLATETABLE DO
(PRIN1 (QUOTE X))
(PRIN1 (CAR X))
(PRIN1 (QUOTE =))
(PRINT (CDR X)))
(QUOTE (TTAB 1.0))
(PRINT (QUOTE END*))
(QUOTE (OTLL 133.0))
(SETQ XLATETABLE NIL)))
EXPR)
STOP